home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 015 / page2.arc / PAGE2CFG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-06-04  |  8.8 KB  |  266 lines
  1. Program Page2Cfg;
  2.  
  3. (*---------------------------------------------------------------------------*)
  4. (*                                                                           *)
  5. (*                         PAGE2CFG  Version 1.0                             *)
  6. (*                                                                           *)
  7. (*             Default Option Customization for the Page2 program            *)
  8. (*                                                                           *)
  9. (*                   by: R. P. Byrne      June 4, 1988                       *)
  10. (*                                                                           *)
  11. (*---------------------------------------------------------------------------*)
  12. (*                                                                           *)
  13. (*   I have placed this program and it's source code into the public         *)
  14. (*   domain in the hope that it may prove useful to someone other than       *)
  15. (*   myself.                                                                 *)
  16. (*                                                                           *)
  17. (*   Please feel free to distribute this program by any means available. I   *)
  18. (*   only ask, as a courtesy, that the program not be distributed without    *)
  19. (*   the inclusion of the source code and the accompanying documentation     *)
  20. (*   file.                                                                   *)
  21. (*                                                                           *)
  22. (*   Since this program is truly public domain software, if you paid         *)
  23. (*   someone more than $5.00 to receive it, you've probably been ripped      *)
  24. (*   off.                                                                    *)
  25. (*                                                                           *)
  26. (*                                                        rpb                *)
  27. (*                                                       6/4/88              *)
  28. (*                                                                           *)
  29. (*---------------------------------------------------------------------------*)
  30.  
  31. Uses Crt,
  32.      Dos,
  33.      StrProcs;
  34.  
  35. Type
  36.    DefaultsRec = Record
  37.                     StartPatch : String[16];           {17}
  38.                     CPL        : Word;                 { 2}
  39.                     LPP        : Word;                 { 2}
  40.                     BindMar    : Word;                 { 2}
  41.                     UseFF      : Boolean;              { 1}
  42.                     OddFirst   : Boolean;              { 1}
  43.                     PrintName  : Boolean;              { 1}
  44.                     PrintDate  : Boolean;              { 1}
  45.                     PrintPgNo  : Boolean;              { 1}
  46.                     EndPatch   : String[14];           {15}
  47.                  end {record};
  48.  
  49. Const
  50.    DefaultsLoc = $4630;                 { Offset of patch area in Page2.Exe }
  51.    InFileName : String = 'Page2.Exe';
  52.  
  53. Var
  54.    Defaults : DefaultsRec;
  55.  
  56.    InFile   : File;
  57.  
  58. { --------------------------------------------------------------------------- }
  59.  
  60. Procedure Abort(ErrMsg : String);
  61. Begin
  62.    If ErrMsg <> '' then begin
  63.       Writeln;
  64.       Writeln(ErrMsg);
  65.       Writeln;
  66.       Writeln('Program aborted.');
  67.       Writeln;
  68.    end {if};
  69.    Halt(255);
  70. End {Abort};
  71.  
  72. { --------------------------------------------------------------------------- }
  73.  
  74. Procedure GetDefaults;
  75. Var
  76.    BytesRead : Word;
  77. Begin
  78.    Assign(InFile, InFileName);
  79.    Reset(InFile, 1);
  80.    Seek(InFile, DefaultsLoc);
  81.    BlockRead(InFile, Defaults, SizeOf(Defaults), BytesRead);
  82.    If BytesRead <> SizeOf(Defaults) then
  83.       Abort('Unexpected end of file encountered in ' + InFileName);
  84.    If (Defaults.StartPatch <> 'Patch Area Start') or
  85.       (Defaults.EndPatch   <> 'Patch Area End')   then
  86.       Abort('Synch error in file ' + InFileName);
  87.    Close(InFile);
  88. end {GetDefaults};
  89.  
  90. { --------------------------------------------------------------------------- }
  91.  
  92. Procedure SetDefaults;
  93. Const
  94.    ReadWriteMode = 2;
  95. Begin
  96.    Assign(InFile, InFileName);
  97.    FileMode := ReadWriteMode;
  98.    Reset(InFile, 1);
  99.    Seek(InFile, DefaultsLoc);
  100.    BlockWrite(InFile, Defaults, SizeOf(Defaults));
  101.    Close(InFile);
  102. end {SetDefaults};
  103.  
  104. { --------------------------------------------------------------------------- }
  105.  
  106. Procedure GetNewDefaults;
  107. Var
  108.    Answer  : String;
  109.    TestNum : Integer;
  110.    Code    : Integer;
  111. Begin
  112.    With Defaults do begin
  113.       Repeat
  114.          Answer := '';
  115.          Write('Enter default page width in characters [', CPL, ']: ');
  116.          Readln(Answer);
  117.          Code := 0;
  118.          If Answer = '' then
  119.             TestNum := CPL
  120.          else
  121.             Val(Answer, TestNum, Code);
  122.       Until (Code = 0) or (TestNum > 0);
  123.       CPL := TestNum;
  124.  
  125.       Repeat
  126.          Answer := '';
  127.          Write('Enter default page length in lines [', LPP, ']: ');
  128.          Readln(Answer);
  129.          Code := 0;
  130.          If Answer = '' then
  131.             TestNum := LPP
  132.          else
  133.             Val(Answer, TestNum, Code);
  134.       Until (Code = 0) or (TestNum > 0);
  135.       LPP := TestNum;
  136.  
  137.       Repeat
  138.          Answer := '';
  139.          Write('Enter default gutter margin size in characters [', BindMar, ']: ');
  140.          Readln(Answer);
  141.          Code := 0;
  142.          If Answer = '' then
  143.             TestNum := BindMar
  144.          else
  145.             Val(Answer, TestNum, Code);
  146.       Until (Code = 0) and (TestNum >= 0);
  147.       BindMar := TestNum;
  148.  
  149.       Repeat
  150.          Answer := '';
  151.          Write('Follow every page with a formfeed? [');
  152.          If UseFF then
  153.             Write('Y]: ')
  154.          else
  155.             Write('N]: ');
  156.          Readln(Answer);
  157.          If Answer = '' then
  158.             If UseFF then
  159.                Answer := 'Y'
  160.             else
  161.                Answer := 'N';
  162.          Answer := Strip(Answer);
  163.       Until (Upcase(Answer[1]) in ['Y', 'N']);
  164.       UseFF := (UpCase(Answer[1]) = 'Y');
  165.  
  166.       Repeat
  167.          Answer := '';
  168.          Write('Print the odd pages first? [');
  169.          If OddFirst then
  170.             Write('Y]: ')
  171.          else
  172.             Write('N]: ');
  173.          Readln(Answer);
  174.          If Answer = '' then
  175.             If OddFirst then
  176.                Answer := 'Y'
  177.             else
  178.                Answer := 'N';
  179.          Answer := Strip(Answer);
  180.       Until (Upcase(Answer[1]) in ['Y', 'N']);
  181.       OddFirst := (UpCase(Answer[1]) = 'Y');
  182.  
  183.       Repeat
  184.          Answer := '';
  185.          Write('Include the file name in a running header? [');
  186.          If PrintName then
  187.             Write('Y]: ')
  188.          else
  189.             Write('N]: ');
  190.          Readln(Answer);
  191.          If Answer = '' then
  192.             If PrintName then
  193.                Answer := 'Y'
  194.             else
  195.                Answer := 'N';
  196.          Answer := Strip(Answer);
  197.       Until (Upcase(Answer[1]) in ['Y', 'N']);
  198.       PrintName := (UpCase(Answer[1]) = 'Y');
  199.  
  200.       Repeat
  201.          Answer := '';
  202.          Write('Include the current date in a running header? [');
  203.          If PrintDate then
  204.             Write('Y]: ')
  205.          else
  206.             Write('N]: ');
  207.          Readln(Answer);
  208.          If Answer = '' then
  209.             If PrintDate then
  210.                Answer := 'Y'
  211.             else
  212.                Answer := 'N';
  213.          Answer := Strip(Answer);
  214.       Until (Upcase(Answer[1]) in ['Y', 'N']);
  215.       PrintDate := (UpCase(Answer[1]) = 'Y');
  216.  
  217.       Repeat
  218.          Answer := '';
  219.          Write('Include the page number in a running header? [');
  220.          If PrintPgNo then
  221.             Write('Y]: ')
  222.          else
  223.             Write('N]: ');
  224.          Readln(Answer);
  225.          If Answer = '' then
  226.             If PrintPgNo then
  227.                Answer := 'Y'
  228.             else
  229.                Answer := 'N';
  230.          Answer := Strip(Answer);
  231.       Until (Upcase(Answer[1]) in ['Y', 'N']);
  232.       PrintPgNo := (UpCase(Answer[1]) = 'Y');
  233.  
  234.    end {with};
  235. end {GetNewDefaults};
  236.  
  237. { --------------------------------------------------------------------------- }
  238.  
  239. Var
  240.    Next : Char;
  241. Begin
  242.    Repeat
  243.       TextColor(Yellow);
  244.       TextBackground(Black);
  245.       ClrScr;
  246.       Writeln;
  247.       Writeln('Page2 - Generic 2-sided print utility - by R. P. Byrne 5/24/88');
  248.       Writeln;
  249.       Writeln('Customization program for default program option settings');
  250.       Writeln;
  251.       TextColor(LightGreen);
  252.       GetDefaults;
  253.       GetNewDefaults;
  254.       TextColor(Yellow);
  255.       Writeln;
  256.       Writeln('What next?');
  257.       Write('(S)ave new settings, (Q)uit without save, (R)especify settings? ');
  258.       Repeat
  259.          Next := ReadKey;
  260.       Until (Upcase(Next) in ['S', 'Q', 'R']);
  261.       Writeln(UpCase(Next));
  262.       If UpCase(Next) = 'S' then
  263.          SetDefaults;
  264.    Until (Upcase(Next) <> 'R');
  265. End.
  266.